home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kolekce / d6 / rxlibsetup.exe / {app} / units / DBUTILS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-02-19  |  24.4 KB  |  845 lines

  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 2001,2002 SGB Software          }
  6. {         Copyright (c) 1997, 1998 Fedor Koshevnikov,   }
  7. {                        Igor Pavluk and Serge Korolev  }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit DBUtils;
  12.  
  13. {$I RX.INC}
  14. {$W-,R-,B-,N+,P+}
  15.  
  16. interface
  17.  
  18. uses {$IFDEF WIN32} Windows, Registry, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  19.   Classes, SysUtils, DB, {$IFNDEF RX_D3} DBTables, {$ENDIF} IniFiles;
  20.  
  21. type
  22.  
  23. { TLocateObject }
  24.  
  25.   TLocateObject = class(TObject)
  26.   private
  27.     FDataSet: TDataSet;
  28.     FLookupField: TField;
  29.     FLookupValue: string;
  30.     FLookupExact, FCaseSensitive: Boolean;
  31.     FBookmark: TBookmark;
  32.     FIndexSwitch: Boolean;
  33.     procedure SetDataSet(Value: TDataSet);
  34.   protected
  35.     function MatchesLookup(Field: TField): Boolean;
  36.     procedure CheckFieldType(Field: TField); virtual;
  37.     procedure ActiveChanged; virtual;
  38.     function LocateFilter: Boolean; virtual;
  39.     function LocateKey: Boolean; virtual;
  40.     function LocateFull: Boolean; virtual;
  41.     function UseKey: Boolean; virtual;
  42.     function FilterApplicable: Boolean; virtual;
  43.     property LookupField: TField read FLookupField;
  44.     property LookupValue: string read FLookupValue;
  45.     property LookupExact: Boolean read FLookupExact;
  46.     property CaseSensitive: Boolean read FCaseSensitive;
  47.     property Bookmark: TBookmark read FBookmark write FBookmark;
  48.   public
  49.     function Locate(const KeyField, KeyValue: string; Exact,
  50.       CaseSensitive: Boolean): Boolean;
  51.     property DataSet: TDataSet read FDataSet write SetDataSet;
  52.     property IndexSwitch: Boolean read FIndexSwitch write FIndexSwitch;
  53.   end;
  54.  
  55. type
  56.   TCreateLocateObject = function: TLocateObject;
  57. const
  58.   CreateLocateObject: TCreateLocateObject = nil;
  59. function CreateLocate(DataSet: TDataSet): TLocateObject;
  60.  
  61. { Utility routines }
  62.  
  63. function IsDataSetEmpty(DataSet: TDataSet): Boolean;
  64. procedure RefreshQuery(Query: TDataSet);
  65. function DataSetSortedSearch(DataSet: TDataSet; const Value,
  66.   FieldName: string; CaseInsensitive: Boolean): Boolean;
  67. function DataSetSectionName(DataSet: TDataSet): string;
  68. procedure InternalSaveFields(DataSet: TDataSet; IniFile: TObject;
  69.   const Section: string);
  70. procedure InternalRestoreFields(DataSet: TDataSet; IniFile: TObject;
  71.   const Section: string; RestoreVisible: Boolean);
  72. {$IFDEF WIN32}
  73. function DataSetLocateThrough(DataSet: TDataSet; const KeyFields: string;
  74.   const KeyValues: Variant; Options: TLocateOptions): Boolean;
  75. procedure SaveFieldsReg(DataSet: TDataSet; IniFile: TRegIniFile);
  76. procedure RestoreFieldsReg(DataSet: TDataSet; IniFile: TRegIniFile;
  77.   RestoreVisible: Boolean);
  78. {$ENDIF WIN32}
  79. procedure SaveFields(DataSet: TDataSet; IniFile: TIniFile);
  80. procedure RestoreFields(DataSet: TDataSet; IniFile: TIniFile;
  81.   RestoreVisible: Boolean);
  82. procedure AssignRecord(Source, Dest: TDataSet; ByName: Boolean);
  83. function ConfirmDelete: Boolean;
  84. procedure ConfirmDataSetCancel(DataSet: TDataSet);
  85. procedure CheckRequiredField(Field: TField);
  86. procedure CheckRequiredFields(const Fields: array of TField);
  87.  
  88. { SQL expressions }
  89.  
  90. function DateToSQL(Value: TDateTime): string;
  91. function FormatSQLDateRange(Date1, Date2: TDateTime;
  92.   const FieldName: string): string;
  93. function FormatSQLDateRangeEx(Date1, Date2: TDateTime;
  94.   const FieldName: string): string;
  95. function FormatSQLNumericRange(const FieldName: string;
  96.   LowValue, HighValue, LowEmpty, HighEmpty: Double; Inclusive: Boolean): string;
  97. function StrMaskSQL(const Value: string): string;
  98. function FormatSQLCondition(const FieldName, Operator, Value: string;
  99.   FieldType: TFieldType; Exact: Boolean): string;
  100. function FormatAnsiSQLCondition(const FieldName, Operator, Value: string;
  101.   FieldType: TFieldType; Exact: Boolean): string;
  102.  
  103. const
  104.   TrueExpr = '0=0';
  105.  
  106. const
  107.   { Server Date formats}
  108.   sdfStandard16 = '''"''mm''/''dd''/''yyyy''"'''; {"mm/dd/yyyy"}
  109.   sdfStandard32 = '''''''dd/mm/yyyy''''''';       {'dd/mm/yyyy'}
  110.   sdfOracle     = '"TO_DATE(''"dd/mm/yyyy"'', ''DD/MM/YYYY'')"';
  111.   sdfInterbase  = '"CAST(''"mm"/"dd"/"yyyy"'' AS DATE)"';
  112.   sdfMSSQL      = '"CONVERT(datetime, ''"mm"/"dd"/"yyyy"'', 103)"';
  113.  
  114. const
  115.   ServerDateFmt: string[50] = sdfStandard16;
  116.  
  117. {$IFNDEF WIN32}
  118. type
  119.   TBlobType = ftBlob..ftGraphic;
  120. {$ENDIF}
  121.  
  122. const
  123. {$IFNDEF RX_D4}
  124.   {$IFDEF WIN32}
  125.   ftBlobTypes = [ftBlob..ftTypedBinary];
  126.   {$ELSE}
  127.   ftBlobTypes = [ftBlob..ftGraphic];
  128.   {$ENDIF}
  129. {$ELSE}
  130.   ftBlobTypes = [Low(TBlobType)..High(TBlobType)];
  131. {$ENDIF RX_D3}
  132. {$IFDEF RX_V110} {$NODEFINE ftBlobTypes} {$ENDIF}
  133.  
  134. {$IFNDEF RX_D4}
  135.   ftNonTextTypes = [ftBytes, ftVarBytes, ftBlob, ftMemo, ftGraphic
  136.     {$IFDEF WIN32}, ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary
  137.     {$IFDEF RX_D3}, ftCursor {$ENDIF} {$ENDIF}];
  138.   {$IFDEF VER110} { C++ Builder 3 or higher }
  139.   {$NODEFINE ftNonTextTypes}
  140.   (*$HPPEMIT 'namespace Dbutils'*)
  141.   (*$HPPEMIT '{'*)
  142.   (*$HPPEMIT '#define ftNonTextTypes (System::Set<TFieldType, ftUnknown, ftCursor> () \'*)
  143.   (*$HPPEMIT '        << ftBytes << ftVarBytes << ftBlob << ftMemo << ftGraphic \'*)
  144.   (*$HPPEMIT '        << ftFmtMemo << ftParadoxOle << ftDBaseOle << ftTypedBinary << ftCursor )'*)
  145.   (*$HPPEMIT '}'*)
  146.   {$ENDIF}
  147. type
  148.   Largeint = Longint;
  149.   {$IFDEF VER110} {$NODEFINE Largeint} {$ENDIF}
  150. {$ENDIF RX_D4}
  151.  
  152. {$IFDEF RX_D3}
  153. procedure _DBError(const Msg: string);
  154. {$ELSE}
  155. procedure _DBError(Ident: Word);
  156. {$ENDIF}
  157.  
  158. implementation
  159.  
  160. uses Forms, Controls, Dialogs, Consts, DBConsts, RXDConst, VCLUtils, FileUtil,
  161.   AppUtils, rxStrUtils, MaxMin, {$IFNDEF RX_D3} BdeUtils, {$ENDIF}
  162.   {$IFNDEF WIN32} Str16, {$ENDIF} DateUtil;
  163.  
  164. { Utility routines }
  165.  
  166. {$IFDEF RX_D3}
  167. procedure _DBError(const Msg: string);
  168. begin
  169.   DatabaseError(Msg);
  170. {$ELSE}
  171. procedure _DBError(Ident: Word);
  172. begin
  173.   DBError(Ident);
  174. {$ENDIF}
  175. end;
  176.  
  177. function ConfirmDelete: Boolean;
  178. begin
  179.   Screen.Cursor := crDefault;
  180.   Result := MessageDlg(ResStr(SDeleteRecordQuestion), mtConfirmation,
  181.     [mbYes, mbNo], 0) = mrYes;
  182. end;
  183.  
  184. procedure ConfirmDataSetCancel(DataSet: TDataSet);
  185. begin
  186.   if DataSet.State in [dsEdit, dsInsert] then begin
  187.     DataSet.UpdateRecord;
  188.     if DataSet.Modified then begin
  189.       case MessageDlg(LoadStr(SConfirmSave), mtConfirmation, mbYesNoCancel, 0) of
  190.         mrYes: DataSet.Post;
  191.         mrNo: DataSet.Cancel;
  192.         else SysUtils.Abort;
  193.       end;
  194.     end
  195.     else DataSet.Cancel;
  196.   end;
  197. end;
  198.  
  199. {$IFDEF RX_D3}
  200. function SetToBookmark(ADataSet: TDataSet; ABookmark: TBookmark): Boolean;
  201. begin
  202.   Result := False;
  203.   with ADataSet do
  204.     if Active and (ABookmark <> nil) and not (Bof and Eof) and
  205.       BookmarkValid(ABookmark) then
  206.     try
  207.       ADataSet.GotoBookmark(ABookmark);
  208.       Result := True;
  209.     except
  210.     end;
  211. end;
  212. {$ENDIF}
  213.  
  214. { Refresh Query procedure }
  215.  
  216. procedure RefreshQuery(Query: TDataSet);
  217. var
  218.   BookMk: TBookmark;
  219. begin
  220.   with Query do begin
  221.     DisableControls;
  222.     try
  223.       if Active then BookMk := GetBookmark else BookMk := nil;
  224.       try
  225.         Close;
  226.         Open;
  227. {$IFDEF RX_D3}
  228.         SetToBookmark(Query, BookMk);
  229. {$ELSE}
  230.         if Query is TDBDataSet then SetToBookmark(Query, BookMk);
  231. {$ENDIF}
  232.       finally
  233.         if BookMk <> nil then FreeBookmark(BookMk);
  234.       end;
  235.     finally
  236.       EnableControls;
  237.     end;
  238.   end;
  239. end;
  240.  
  241. { TLocateObject }
  242.  
  243. procedure TLocateObject.SetDataSet(Value: TDataSet);
  244. begin
  245.   ActiveChanged;
  246.   FDataSet := Value;
  247. end;
  248.  
  249. function TLocateObject.LocateFull: Boolean;
  250. begin
  251.   Result := False;
  252.   with DataSet do begin
  253.     First;
  254.     while not EOF do begin
  255.       if MatchesLookup(FLookupField) then begin
  256.         Result := True;
  257.         Break;
  258.       end;
  259.       Next;
  260.     end;
  261.   end;
  262. end;
  263.  
  264. function TLocateObject.LocateKey: Boolean;
  265. begin
  266.   Result := False;
  267. end;
  268.  
  269. function TLocateObject.FilterApplicable: Boolean;
  270. begin
  271. {$IFDEF RX_D3}
  272.   Result := FLookupField.FieldKind in [fkData, fkInternalCalc];
  273. {$ELSE}
  274.   Result := ({$IFDEF WIN32} FLookupField.FieldKind = fkData {$ELSE}
  275.     not FLookupField.Calculated {$ENDIF}) and IsFilterApplicable(DataSet);
  276. {$ENDIF}
  277. end;
  278.  
  279. function TLocateObject.LocateFilter: Boolean;
  280. {$IFDEF WIN32}
  281. var
  282.   SaveCursor: TCursor;
  283.   Options: TLocateOptions;
  284.   Value: Variant;
  285. begin
  286.   SaveCursor := Screen.Cursor;
  287.   Screen.Cursor := crHourGlass;
  288.   try
  289.     Options := [];
  290.     if not FCaseSensitive then Include(Options, loCaseInsensitive);
  291.     if not FLookupExact then Include(Options, loPartialKey);
  292.     if (FLookupValue = '') then VarClear(Value)
  293.     else Value := FLookupValue;
  294.     Result := DataSet.Locate(FLookupField.FieldName, Value, Options);
  295.   finally
  296.     Screen.Cursor := SaveCursor;
  297.   end;
  298. {$ELSE}
  299. begin
  300.   Result := False;
  301. {$ENDIF}
  302. end;
  303.  
  304. procedure TLocateObject.CheckFieldType(Field: TField);
  305. begin
  306. end;
  307.  
  308. function TLocateObject.Locate(const KeyField, KeyValue: string;
  309.   Exact, CaseSensitive: Boolean): Boolean;
  310. var
  311.   LookupKey: TField;
  312. begin
  313.   if DataSet = nil then begin
  314.     Result := False;
  315.     Exit;
  316.   end;
  317.   DataSet.CheckBrowseMode;
  318.   LookupKey := DataSet.FieldByName(KeyField);
  319.   DataSet.CursorPosChanged;
  320.   FLookupField := LookupKey;
  321.   FLookupValue := KeyValue;
  322.   FLookupExact := Exact;
  323.   FCaseSensitive := CaseSensitive;
  324.   if FLookupField.DataType <> ftString then begin
  325.     FCaseSensitive := True;
  326.     try
  327.       CheckFieldType(FLookupField);
  328.     except
  329.       Result := False;
  330.       Exit;
  331.     end;
  332.   end;
  333.   FBookmark := DataSet.GetBookmark;
  334.   try
  335.     DataSet.DisableControls;
  336.     try
  337.       Result := MatchesLookup(FLookupField);
  338.       if not Result then begin
  339.         if UseKey then Result := LocateKey
  340.         else begin
  341.           if FilterApplicable then Result := LocateFilter
  342.           else Result := LocateFull;
  343.         end;
  344.         if not Result then SetToBookmark(DataSet, FBookmark);
  345.       end;
  346.     finally
  347.       DataSet.EnableControls;
  348.     end;
  349.   finally
  350.     FLookupValue := EmptyStr;
  351.     FLookupField := nil;
  352.     DataSet.FreeBookmark(FBookmark);
  353.     FBookmark := nil;
  354.   end;
  355. end;
  356.  
  357. function TLocateObject.UseKey: Boolean;
  358. begin
  359.   Result := False;
  360. end;
  361.  
  362. procedure TLocateObject.ActiveChanged;
  363. begin
  364. end;
  365.  
  366. function TLocateObject.MatchesLookup(Field: TField): Boolean;
  367. var
  368.   Temp: string;
  369. begin
  370.   Temp := Field.AsString;
  371.   if not FLookupExact then
  372.     SetLength(Temp, Min(Length(FLookupValue), Length(Temp)));
  373.   if FCaseSensitive then Result := AnsiCompareStr(Temp, FLookupValue) = 0
  374.   else Result := AnsiCompareText(Temp, FLookupValue) = 0;
  375. end;
  376.  
  377. function CreateLocate(DataSet: TDataSet): TLocateObject;
  378. begin
  379.   if Assigned(CreateLocateObject) then Result := CreateLocateObject
  380.   else Result := TLocateObject.Create;
  381.   if (Result <> nil) and (DataSet <> nil) then
  382.     Result.DataSet := DataSet;
  383. end;
  384.  
  385. { DataSet locate routines }
  386.  
  387. {$IFDEF WIN32}
  388. function DataSetLocateThrough(DataSet: TDataSet; const KeyFields: string;
  389.   const KeyValues: Variant; Options: TLocateOptions): Boolean;
  390. var
  391.   FieldCount: Integer;
  392.   Fields: TList;
  393.   Bookmark: TBookmarkStr;
  394.  
  395.   function CompareField(Field: TField; Value: Variant): Boolean;
  396.   var
  397.     S: string;
  398.   begin
  399.     if Field.DataType = ftString then begin
  400.       S := Field.AsString;
  401.       if (loPartialKey in Options) then
  402.         Delete(S, Length(Value) + 1, MaxInt);
  403.       if (loCaseInsensitive in Options) then
  404.         Result := AnsiCompareText(S, Value) = 0
  405.       else
  406.         Result := AnsiCompareStr(S, Value) = 0;
  407.     end
  408.     else Result := (Field.Value = Value);
  409.   end;
  410.  
  411.   function CompareRecord: Boolean;
  412.   var
  413.     I: Integer;
  414.   begin
  415.     if FieldCount = 1 then
  416.       Result := CompareField(TField(Fields.First), KeyValues)
  417.     else begin
  418.       Result := True;
  419.       for I := 0 to FieldCount - 1 do
  420.         Result := Result and CompareField(TField(Fields[I]), KeyValues[I]);
  421.     end;
  422.   end;
  423.  
  424. begin
  425.   Result := False;
  426.   with DataSet do begin
  427.     CheckBrowseMode;
  428.     if BOF and EOF then Exit;
  429.   end;
  430.   Fields := TList.Create;
  431.   try
  432.     DataSet.GetFieldList(Fields, KeyFields);
  433.     FieldCount := Fields.Count;
  434.     Result := CompareRecord;
  435.     if Result then Exit;
  436.     DataSet.DisableControls;
  437.     try
  438.       Bookmark := DataSet.Bookmark;
  439.       try
  440.         with DataSet do begin
  441.           First;
  442.           while not EOF do begin
  443.             Result := CompareRecord;
  444.             if Result then Break;
  445.             Next;
  446.           end;
  447.         end;
  448.       finally
  449.         if not Result {$IFDEF RX_D3} and
  450.           DataSet.BookmarkValid(PChar(Bookmark)) {$ENDIF} then
  451.           DataSet.Bookmark := Bookmark;
  452.       end;
  453.     finally
  454.       DataSet.EnableControls;
  455.     end;
  456.   finally
  457.     Fields.Free;
  458.   end;
  459. end;
  460. {$ENDIF}
  461.  
  462. { DataSetSortedSearch. Navigate on sorted DataSet routine. }
  463.  
  464. function DataSetSortedSearch(DataSet: TDataSet; const Value,
  465.   FieldName: string; CaseInsensitive: Boolean): Boolean;
  466. var
  467.   L, H, I: Longint;
  468.   CurrentPos: Longint;
  469.   CurrentValue: string;
  470.   BookMk: TBookmark;
  471.   Field: TField;
  472.  
  473.   function UpStr(const Value: string): string;
  474.   begin
  475.     if CaseInsensitive then Result := AnsiUpperCase(Value)
  476.     else Result := Value;
  477.   end;
  478.  
  479.   function GetCurrentStr: string;
  480.   begin
  481.     Result := Field.AsString;
  482.     if Length(Result) > Length(Value) then
  483.       SetLength(Result, Length(Value));
  484.     Result := UpStr(Result);
  485.   end;
  486.  
  487. begin
  488.   Result := False;
  489.   if DataSet = nil then Exit;
  490.   Field := DataSet.FindField(FieldName);
  491.   if Field = nil then Exit;
  492.   if Field.DataType = ftString then begin
  493.     DataSet.DisableControls;
  494.     BookMk := DataSet.GetBookmark;
  495.     try
  496.       L := 0;
  497.       DataSet.First;
  498.       CurrentPos := 0;
  499.       H := DataSet.RecordCount - 1;
  500.       if Value <> '' then begin
  501.         while L <= H do begin
  502.           I := (L + H) shr 1;
  503.           if I <> CurrentPos then DataSet.MoveBy(I - CurrentPos);
  504.           CurrentPos := I;
  505.           CurrentValue := GetCurrentStr;
  506.           if (UpStr(Value) > CurrentValue) then
  507.             L := I + 1
  508.           else begin
  509.             H := I - 1;
  510.             if (UpStr(Value) = CurrentValue) then Result := True;
  511.           end;
  512.         end; { while }
  513.         if Result then begin
  514.           if (L <> CurrentPos) then DataSet.MoveBy(L - CurrentPos);
  515.           while (L < DataSet.RecordCount) and
  516.             (UpStr(Value) <> GetCurrentStr) do
  517.           begin
  518.             Inc(L);
  519.             DataSet.MoveBy(1);
  520.           end;
  521.         end;
  522.       end
  523.       else Result := True;
  524.       if not Result then SetToBookmark(DataSet, BookMk);
  525.     finally
  526.       DataSet.FreeBookmark(BookMk);
  527.       DataSet.EnableControls;
  528.     end;
  529.   end
  530.   else
  531. {$IFDEF RX_D3}
  532.     DatabaseErrorFmt(SFieldTypeMismatch, [Field.DisplayName]);
  533. {$ELSE}
  534.     DBErrorFmt(SFieldTypeMismatch,
  535.       [Field.DisplayName{$IFNDEF WIN32}^{$ENDIF}]);
  536. {$ENDIF}
  537. end;
  538.  
  539. { Save and restore DataSet Fields layout }
  540.  
  541. function DataSetSectionName(DataSet: TDataSet): string;
  542. begin
  543.   with DataSet do
  544.     if (Owner <> nil) and (Owner is TCustomForm) then
  545.       Result := GetDefaultSection(Owner as TCustomForm)
  546.     else Result := Name;
  547. end;
  548.  
  549. function CheckSection(DataSet: TDataSet; const Section: string): string;
  550. begin
  551.   Result := Section;
  552.   if Result = '' then Result := DataSetSectionName(DataSet);
  553. end;
  554.  
  555. procedure InternalSaveFields(DataSet: TDataSet; IniFile: TObject;
  556.   const Section: string);
  557. var
  558.   I: Integer;
  559. begin
  560.   with DataSet do begin
  561.     for I := 0 to FieldCount - 1 do begin
  562.       IniWriteString(IniFile, CheckSection(DataSet, Section),
  563.         Name + Fields[I].FieldName,
  564.         Format('%d,%d,%d', [Fields[I].Index, Fields[I].DisplayWidth,
  565.         Integer(Fields[I].Visible)]));
  566.     end;
  567.   end;
  568. end;
  569.  
  570. procedure InternalRestoreFields(DataSet: TDataSet; IniFile: TObject;
  571.   const Section: string; RestoreVisible: Boolean);
  572. type
  573.   TFieldInfo = record
  574.     Field: TField;
  575.     EndIndex: Integer;
  576.   end;
  577.   PFieldArray = ^TFieldArray;
  578.   TFieldArray = array[0..(65528 div SizeOf(TFieldInfo)) - 1] of TFieldInfo;
  579. const
  580.   Delims = [' ',','];
  581. var
  582.   I, J: Integer;
  583.   S: string;
  584.   FieldArray: PFieldArray;
  585. begin
  586.   with DataSet do begin
  587.     FieldArray := AllocMemo(FieldCount * SizeOf(TFieldInfo));
  588.     try
  589.       for I := 0 to FieldCount - 1 do begin
  590.         S := IniReadString(IniFile, CheckSection(DataSet, Section),
  591.           Name + Fields[I].FieldName, '');
  592.         FieldArray^[I].Field := Fields[I];
  593.         FieldArray^[I].EndIndex := Fields[I].Index;
  594.         if S <> '' then begin
  595.           FieldArray^[I].EndIndex := StrToIntDef(ExtractWord(1, S, Delims),
  596.             FieldArray^[I].EndIndex);
  597.           Fields[I].DisplayWidth := StrToIntDef(ExtractWord(2, S, Delims),
  598.             Fields[I].DisplayWidth);
  599.           if RestoreVisible then
  600.             Fields[I].Visible := Boolean(StrToIntDef(ExtractWord(3, S, Delims),
  601.               Integer(Fields[I].Visible)));
  602.         end;
  603.       end;
  604.       for I := 0 to FieldCount - 1 do begin
  605.         for J := 0 to FieldCount - 1 do begin
  606.           if FieldArray^[J].EndIndex = I then begin
  607.             FieldArray^[J].Field.Index := FieldArray^[J].EndIndex;
  608.             Break;
  609.           end;
  610.         end;
  611.       end;
  612.     finally
  613.       FreeMemo(Pointer(FieldArray));
  614.     end;
  615.   end;
  616. end;
  617.  
  618. {$IFDEF WIN32}
  619. procedure SaveFieldsReg(DataSet: TDataSet; IniFile: TRegIniFile);
  620. begin
  621.   InternalSaveFields(DataSet, IniFile, DataSetSectionName(DataSet));
  622. end;
  623.  
  624. procedure RestoreFieldsReg(DataSet: TDataSet; IniFile: TRegIniFile;
  625.   RestoreVisible: Boolean);
  626. begin
  627.   InternalRestoreFields(DataSet, IniFile, DataSetSectionName(DataSet),
  628.     RestoreVisible);
  629. end;
  630. {$ENDIF WIN32}
  631.  
  632. procedure SaveFields(DataSet: TDataSet; IniFile: TIniFile);
  633. begin
  634.   InternalSaveFields(DataSet, IniFile, DataSetSectionName(DataSet));
  635. end;
  636.  
  637. procedure RestoreFields(DataSet: TDataSet; IniFile: TIniFile;
  638.   RestoreVisible: Boolean);
  639. begin
  640.   InternalRestoreFields(DataSet, IniFile, DataSetSectionName(DataSet),
  641.     RestoreVisible);
  642. end;
  643.  
  644. function IsDataSetEmpty(DataSet: TDataSet): Boolean;
  645. begin
  646.   with DataSet do Result := (not Active) or (Eof and Bof);
  647. end;
  648.  
  649. { SQL expressions }
  650.  
  651. function DateToSQL(Value: TDateTime): string;
  652. begin
  653.   Result := IntToStr(Trunc(Value));
  654. end;
  655.  
  656. function FormatSQLDateRange(Date1, Date2: TDateTime;
  657.   const FieldName: string): string;
  658. begin
  659.   Result := TrueExpr;
  660.   if (Date1 = Date2) and (Date1 <> NullDate) then begin
  661.     Result := Format('%s = %s', [FieldName, FormatDateTime(ServerDateFmt,
  662.       Date1)]);
  663.   end
  664.   else if (Date1 <> NullDate) or (Date2 <> NullDate) then begin
  665.     if Date1 = NullDate then
  666.       Result := Format('%s < %s', [FieldName,
  667.         FormatDateTime(ServerDateFmt, IncDay(Date2, 1))])
  668.     else if Date2 = NullDate then
  669.       Result := Format('%s > %s', [FieldName,
  670.         FormatDateTime(ServerDateFmt, IncDay(Date1, -1))])
  671.     else
  672.       Result := Format('(%s < %s) AND (%s > %s)',
  673.         [FieldName, FormatDateTime(ServerDateFmt, IncDay(Date2, 1)),
  674.         FieldName, FormatDateTime(ServerDateFmt, IncDay(Date1, -1))]);
  675.   end;
  676. end;
  677.  
  678. function FormatSQLDateRangeEx(Date1, Date2: TDateTime;
  679.   const FieldName: string): string;
  680. begin
  681.   Result := TrueExpr;
  682.   if (Date1 <> NullDate) or (Date2 <> NullDate) then begin
  683.     if Date1 = NullDate then
  684.       Result := Format('%s < %s', [FieldName,
  685.         FormatDateTime(ServerDateFmt, IncDay(Date2, 1))])
  686.     else if Date2 = NullDate then
  687.       Result := Format('%s >= %s', [FieldName,
  688.         FormatDateTime(ServerDateFmt, Date1)])
  689.     else
  690.       Result := Format('(%s < %s) AND (%s >= %s)',
  691.         [FieldName, FormatDateTime(ServerDateFmt, IncDay(Date2, 1)),
  692.         FieldName, FormatDateTime(ServerDateFmt, Date1)]);
  693.   end;
  694. end;
  695.  
  696. function FormatSQLNumericRange(const FieldName: string;
  697.   LowValue, HighValue, LowEmpty, HighEmpty: Double; Inclusive: Boolean): string;
  698. const
  699.   Operators: array[Boolean, 1..2] of string[2] = (('>', '<'), ('>=', '<='));
  700. begin
  701.   Result := TrueExpr;
  702.   if (LowValue = HighValue) and (LowValue <> LowEmpty) then begin
  703.     Result := Format('%s = %g', [FieldName, LowValue]);
  704.   end
  705.   else if (LowValue <> LowEmpty) or (HighValue <> HighEmpty) then begin
  706.     if LowValue = LowEmpty then
  707.       Result := Format('%s %s %g', [FieldName, Operators[Inclusive, 2], HighValue])
  708.     else if HighValue = HighEmpty then
  709.       Result := Format('%s %s %g', [FieldName, Operators[Inclusive, 1], LowValue])
  710.     else begin
  711.       Result := Format('(%s %s %g) AND (%s %s %g)',
  712.         [FieldName, Operators[Inclusive, 2], HighValue,
  713.         FieldName, Operators[Inclusive, 1], LowValue]);
  714.     end;
  715.   end;
  716. end;
  717.  
  718. function StrMaskSQL(const Value: string): string;
  719. begin
  720.   if (Pos('*', Value) = 0) and (Pos('?', Value) = 0) and (Value <> '') then
  721.     Result := '*' + Value + '*'
  722.   else Result := Value;
  723. end;
  724.  
  725. function FormatSQLCondition(const FieldName, Operator, Value: string;
  726.   FieldType: TFieldType; Exact: Boolean): string;
  727. var
  728.   EmptyValue: Boolean;
  729.   FieldValue: string;
  730.   DateValue: TDateTime;
  731.   LogicOperator: string;
  732. begin
  733.   FieldValue := '';
  734.   DateValue := NullDate;
  735.   Exact := Exact or not (FieldType in
  736.     [ftString, ftDate, ftTime, ftDateTime]);
  737.   if FieldType in [ftDate, ftTime, ftDateTime] then begin
  738.     DateValue := StrToDateDef(Value, NullDate);
  739.     EmptyValue := (DateValue = NullDate);
  740.     FieldValue := FormatDateTime(ServerDateFmt, DateValue);
  741.   end
  742.   else begin
  743.     FieldValue := Value;
  744.     EmptyValue := FieldValue = '';
  745.     if not (Exact or EmptyValue) then
  746.       FieldValue := ReplaceStr(ReplaceStr(StrMaskSQL(FieldValue),
  747.         '*', '%'), '?', '_');
  748.     if FieldType = ftString then FieldValue := '''' + FieldValue + '''';
  749.   end;
  750.   LogicOperator := Operator;
  751.   if LogicOperator = '' then begin
  752.     if Exact then LogicOperator := '='
  753.     else begin
  754.       if FieldType = ftString then LogicOperator := 'LIKE'
  755.       else LogicOperator := '>=';
  756.     end;
  757.   end;
  758.   if EmptyValue then Result := TrueExpr
  759.   else if (FieldType = ftDateTime) and Exact then begin
  760.     DateValue := IncDay(DateValue, 1);
  761.     Result := Format('(%s >= %s) and (%s < %s)', [FieldName, FieldValue,
  762.       FieldName, FormatDateTime(ServerDateFmt, DateValue)]);
  763.   end
  764.   else Result := Format('%s %s %s', [FieldName, LogicOperator, FieldValue]);
  765. end;
  766.  
  767. function FormatAnsiSQLCondition(const FieldName, Operator, Value: string;
  768.   FieldType: TFieldType; Exact: Boolean): string;
  769. var
  770.   S, Esc: string;
  771. begin
  772.   Esc := '';
  773.   if not Exact and (FieldType = ftString) then begin
  774.     S := ReplaceStr(ReplaceStr(ReplaceStr(Value, '/', '//'),
  775.       '_', '/_'), '%', '/%');
  776.     if S <> Value then Esc := ' ESCAPE''/''';
  777.   end
  778.   else S := Value;
  779.   Result := FormatSQLCondition(FieldName, Operator, S, FieldType, Exact) + Esc;
  780. end;
  781.  
  782. procedure CheckRequiredField(Field: TField);
  783. begin
  784.   with Field do
  785.     if not ReadOnly and not Calculated and IsNull then begin
  786.       FocusControl;
  787. {$IFDEF WIN32}
  788.   {$IFNDEF RX_D3}
  789.       DBErrorFmt(SFieldRequired, [DisplayName]);
  790.   {$ELSE}
  791.       DatabaseErrorFmt(SFieldRequired, [DisplayName]);
  792.   {$ENDIF}
  793. {$ELSE}
  794.       DBErrorFmt(SFieldRequired, [DisplayName^]);
  795. {$ENDIF WIN32}
  796.     end;
  797. end;
  798.  
  799. procedure CheckRequiredFields(const Fields: array of TField);
  800. var
  801.   I: Integer;
  802. begin
  803.   for I := Low(Fields) to High(Fields) do
  804.     CheckRequiredField(Fields[I]);
  805. end;
  806.  
  807. procedure AssignRecord(Source, Dest: TDataSet; ByName: Boolean);
  808. var
  809.   I: Integer;
  810.   F, FSrc: TField;
  811. begin
  812.   if not (Dest.State in dsEditModes) then _DBError(SNotEditing);
  813.   if ByName then begin
  814.     for I := 0 to Source.FieldCount - 1 do begin
  815.       F := Dest.FindField(Source.Fields[I].FieldName);
  816.       if F <> nil then begin
  817. {$IFDEF WIN32}
  818.         F.Value := Source.Fields[I].Value;
  819. {$ELSE}
  820.         if (F.DataType = Source.Fields[I].DataType) and
  821.           (F.DataSize = Source.Fields[I].DataSize) then
  822.           F.Assign(Source.Fields[I])
  823.         else F.AsString := Source.Fields[I].AsString;
  824. {$ENDIF}
  825.       end;
  826.     end;
  827.   end
  828.   else begin
  829.     for I := 0 to Min(Source.FieldDefs.Count - 1, Dest.FieldDefs.Count - 1) do
  830.     begin
  831.       F := Dest.FindField(Dest.FieldDefs[I].Name);
  832.       FSrc := Source.FindField(Source.FieldDefs[I].Name);
  833.       if (F <> nil) and (FSrc <> nil) then begin
  834. {$IFDEF WIN32}
  835.         F.Value := FSrc.Value;
  836. {$ELSE}
  837.         if F.DataType = FSrc.DataType then F.Assign(FSrc)
  838.         else F.AsString := FSrc.AsString;
  839. {$ENDIF}
  840.       end;
  841.     end;
  842.   end;
  843. end;
  844.  
  845. end.